home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
percnt.zip
/
WNDFNPER.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1991-11-12
|
17KB
|
453 lines
{***************************************************************************
Percent Control Window Procedure Unit $Version$
Window Function Unit
$Author$ $Date$
Copyright 1991 Anthony M. Vitabile
Unit Description
This Turbo Pascal for Windows unit contains the code that
implements the window function for a new kind of control window
for use in dialog boxes. The behavior of the control is
determined by the code contained in this function.
The library uses straight Windows calls and does NOT use Object-
Windows. This is to allow the control to be used by ANY Windows
program.
***************************************************************************}
Unit WndFnPercentCtrl;
Interface
Uses WinTypes;
function PercentCtrlWndFn(HWindow: HWnd;
Message,
wParam : word;
lParam : longint
): longint; export;
Implementation
Uses CtrlCommonDefs, Strings, WinProcs;
function GetPercentage(HWindow: HWnd): integer;
begin { GetPercentage }
GetPercentage := GetWindowWord(HWindow, Pct_Percentage);
end { GetPercentage };
procedure DrawAxis(HWindow: HWnd;
DC : HDC;
var Rect : TRect;
BorderW: integer;
Style : longint);
var
Extent ,
i ,
Mult ,
NoTicks,
Percent,
X : word;
Width : single;
Txt : array [0 .. 3] of char;
Temp : string[3];
begin { DrawAxis }
if Style and Pct_Decades <> 0 { Determine how many points between ticks }
then Mult := 10
else
if Style and Pct_Quarters <> 0
then Mult := 25
else Mult := 50;
NoTicks := 100 div Mult; { Determine the number of ticks on the bar }
Width := (Rect.right - Rect.left - 2 * BorderW) / NoTicks;
X := Rect.left + BorderW;
for i := 0 to NoTicks do
begin
Percent := i * Mult; { Compute the current percentage to print }
Str(Percent:1, Temp);
StrPCopy(Txt, Temp);
Extent := LoWord(GetTextExtent(DC, Txt, StrLen(Txt)));
Rect.left := round(i * Width - Extent / 2) + X;
Rect.right := Rect.left + Extent;
DrawText(DC, Txt, 3, Rect, dt_Left)
end
end { DrawAxis };
procedure DrawShadow(HWindow: HWnd;
DC : HDC;
var Rect : TRect;
Up : boolean;
Offset : integer);
var
NewPen,
OldPen: HPen;
begin { DrawShadow }
if Up { Set up Working rectangle for drawing shadows, etc }
then NewPen := CreatePen(ps_Solid, 1, GetSysColor(color_Window))
else NewPen := CreatePen(ps_Solid, 1, GetSysColor(color_BtnShadow));
if NewPen = 0
then OldPen := 0
else OldPen := SelectObject(DC, NewPen);
MoveTo(DC, Rect.left + (Offset + 1), Rect.bottom - (Offset + 2));
LineTo(DC, Rect.left + (Offset + 1), Rect.top + (Offset + 1));
LineTo(DC, Rect.right - (Offset + 2), Rect.top + (Offset + 1));
MoveTo(DC, Rect.left + (Offset + 2), Rect.bottom - (Offset + 3));
LineTo(DC, Rect.left + (Offset + 2), Rect.top + (Offset + 2));
LineTo(DC, Rect.right - (Offset + 3), Rect.top + (Offset + 2));
if OldPen <> 0
then DeleteObject(SelectObject(DC, OldPen));
if Up { Set up Working rectangle for drawing shadows, etc }
then NewPen := CreatePen(ps_Solid, 1, GetSysColor(color_BtnShadow))
else NewPen := CreatePen(ps_Solid, 1, GetSysColor(color_Window));
if NewPen = 0
then OldPen := 0
else OldPen := SelectObject(DC, NewPen);
MoveTo(DC, Rect.right - (Offset + 2), Rect.top + (Offset + 1));
LineTo(DC, Rect.right - (Offset + 2), Rect.bottom - (Offset + 2));
LineTo(DC, Rect.left + (Offset + 1), Rect.bottom - (Offset + 2));
MoveTo(DC, Rect.right - (Offset + 3), Rect.top + (Offset + 2));
LineTo(DC, Rect.right - (Offset + 3), Rect.bottom - (Offset + 3));
LineTo(DC, Rect.left + (Offset + 2), Rect.bottom - (Offset + 3));
if OldPen <> 0
then DeleteObject(SelectObject(DC, OldPen))
end { DrawShadow };
procedure DrawButton(HWindow: HWnd;
DC : HDC;
var Rect : TRect;
Up : boolean);
var
NewBrush,
OldBrush: HBrush;
NewPen ,
OldPen : HPen;
Offset : integer;
begin { DrawButton }
NewBrush := CreateSolidBrush(GetSysColor(color_BtnFace));
if NewBrush = 0 { Use the new brush if it was made }
then OldBrush := 0
else OldBrush := SelectObject(DC, NewBrush);
NewPen := CreatePen(ps_Solid, 1, GetSysColor(color_WindowFrame));
if NewPen = 0
then OldPen := 0
else OldPen := SelectObject(DC, NewPen);
Rectangle(DC, Rect.left, Rect.top, Rect.right, Rect.bottom);
if OldBrush <> 0 { Restore the original brush now! }
then
begin
SelectObject(DC, OldBrush);
DeleteObject(NewBrush)
end;
if OldPen <> 0
then
begin
SelectObject(DC, OldPen);
DeleteObject(NewPen)
end;
if Up
then Offset := 0
else Offset := 2;
DrawShadow(HWindow, DC, Rect, Up, Offset)
end { DrawButton };
procedure DrawBar(HWindow: HWnd; DC: HDC; var Rect: TRect);
var
Percent: integer;
PctRect: TRect;
begin { DrawBar }
{ First draw the rectangle for the bar }
DrawButton(HWindow, DC, Rect, FALSE);
{ Draw the percentage rectangle }
Percent := GetPercentage(HWindow);
if Percent > 0 { If there's something to be displayed }
then { then draw the rectangle }
begin
PctRect := Rect; { Percent rectangle is inside bar rectangle }
PctRect.right := PctRect.left + { Compute how far to the right the bar is! }
round((Rect.right - Rect.left) *
GetPercentage(HWindow) / 100) + 1;
if PctRect.right > Rect.right
then PctRect.right := Rect.right;
DrawButton(HWindow, DC, PctRect, TRUE)
end
end { DrawBar };
procedure DrawDigits(HWindow: HWnd; DC: HDC; var Rect: TRect);
var
i : integer;
Txt : array [0 .. 4] of char;
Temp: string[4];
begin { DrawDigits }
i := GetPercentage(HWindow);
Str(i:3, Temp);
Temp := Temp + '%';
StrPCopy(Txt, Temp);
i := SetBkMode(DC, Transparent);
DrawText(DC, Txt, length(Temp), Rect, dt_Center or dt_VCenter);
if i <> 0
then SetBkMode(DC, i)
end { DrawDigits };
procedure DrawTicks(HWindow: HWnd;
DC : HDC;
var Rect : TRect;
Style : longint);
var
i ,
Mult ,
NoTicks,
X : word;
Width : single;
begin { DrawTicks }
if Style and Pct_Decades <> 0 { Determine how many points between ticks }
then Mult := 10
else
if Style and Pct_Quarters <> 0
then Mult := 25
else Mult := 50;
NoTicks := 100 div Mult; { Determine the number of ticks on the bar }
Width := (Rect.right - Rect.left) / NoTicks;
for i := 0 to NoTicks do
begin
X := round(i * Width + Rect.left);
if (X >= Rect.right)
then X := Rect.right - 1;
MoveTo(DC, X, Rect.top);
LineTo(DC, X, Rect.bottom)
end
end { DrawTicks };
procedure DrawTitle(HWindow: HWnd;
DC : HDC;
var Rect : TRect);
var
len : integer;
Temp: array [0 .. ctlTitle] of char;
begin { DrawTitle }
len := GetWindowText(HWindow, Temp, sizeof(Temp));
if len > 0
then DrawText(DC, Temp, len, Rect, dt_Center or dt_VCenter)
end { DrawTitle };
procedure EraseBackground(HWindow: HWnd; DC: hDC);
var
Brush ,
OBrush,
NBrush,
WBrush: hBrush;
Parent: HWnd;
LBrush: TLogBrush;
CRect : TRect;
begin { EraseBackground }
WBrush := GetStockObject(White_Brush); { We may need this! }
OBrush := SelectObject(DC, WBrush); { Get the currently selected brush }
SelectObject(DC, OBrush); { Put the original brush back }
Parent := GetParent(HWindow); { Get the window's parent }
if Parent <> 0 { If the control is indeed a child window }
then { Have the parent tell us what brush to use }
Brush := LoWord(SendMessage(Parent, wm_CtlColor, DC, MakeLong(HWindow, ctlcolor_Static)))
else Brush := WBrush; { Otherwise use the white brush }
GetObject(Brush, sizeof(LBrush), @LBrush);{ Get the brush's data }
NBrush := CreateBrushIndirect(LBrush); { Create a brand new brush from data returned above }
UnrealizeObject(NBrush); { Align the brush pattern }
SelectObject (DC, NBrush); { Select the brush }
GetClientRect (HWindow, CRect); { Get the area to be erased }
FillRect (DC, CRect, Brush); { Erase the background }
if Brush <> WBrush { If the background isn't white, draw the shadow }
then DrawShadow(HWindow, DC, CRect, FALSE, 0);
DeleteObject(SelectObject(DC, OBrush)) { Restore the original brush & delete our temp one }
end { EraseBackground };
procedure PaintPercentCtrl(HWindow: HWnd);
var
HasAxis ,
HasPct ,
HasTicks,
HasTitle: boolean;
DC : HDC;
AxisH ,
BarH ,
BarW ,
BorderW ,
CharH ,
CharW ,
Height ,
TickH ,
TitleH ,
WhiteH ,
Width : integer;
Style : longint;
Paint : TPaintStruct;
CRect ,
Rect : TRect;
begin { PaintPercentCtrl }
DC := BeginPaint(HWindow, Paint); { Begin the painting process }
GetClientRect(HWindow, CRect); { Get the area covered by the window }
Style := GetDialogBaseUnits; { Get the dialog base units }
CharH := HiWord(Style); { Store the height of a character }
CharW := LoWord(Style); { Store the width of a character }
{ Set up the variables for drawing the 3 parts of the control }
Height := CRect.bottom - CRect.top; { Compute the client rectangle's height }
Width := CRect.right - CRect.left; { Compute the client rectangle's width }
Style := GetWindowLong(HWindow, gwl_Style); { Get the window's style bits }
HasAxis := Style and Pct_Axis <> 0;
HasPct := Style and Pct_Digits <> 0;
HasTicks := Style and (Pct_Decades or Pct_Quarters or Pct_Halves) <> 0;
HasTitle := GetWindowTextLength(HWindow) > 0;
if not HasAxis { Determine the width of the border }
then BorderW := 0
else BorderW := CharW * 5 div 2;
if BorderW >= Width div 4
then BorderW := 0;
BarW := Width - BorderW * 2; { Determine the width of the percentage bar }
if BarW < BorderW
then BarW := Width;
if not HasAxis { Determine the height of the axis }
then AxisH := 0
else AxisH := CharH;
if not HasTicks { Determine the height of the ticks }
then TickH := 0
else TickH := CharH div 2;
WhiteH := CharH div 4; { Compute white space height }
if not HasTitle
then TitleH := 0
else TitleH := CharH;
BarH := Height; { Compute bar height }
if HasTitle and { If the control has a title }
(BarH - TitleH - WhiteH * 2 > 0) { And it fits in the space we have }
then BarH := BarH - TitleH - WhiteH * 2;{ Then adjust the bar height for the title }
if HasTicks and { If the control has tick marks }
(BarH - TickH - WhiteH div 2 > 0) { And they fit in the space we have }
then BarH := BarH - TickH - WhiteH div 2;{ Then adjust the bar height for the tick marks }
if HasAxis and { If the control has an axis }
(BarH - AxisH - WhiteH > 0) { And it fits in the space we have }
then BarH := BarH - AxisH - WhiteH;
{ Draw the Title }
Rect.top := CRect.top; { Compute the top coordinate of the rectangle }
Rect.left := CRect.left + BorderW; { Compute the left coordinate of the rectangle }
Rect.right := CRect.right - BorderW; { Compute the right coordinate of the rectangle }
if HasTitle
then
begin
Rect.top := Rect.top + WhiteH; { Compute the top coordinate of the Title rectangle }
Rect.bottom := Rect.top + TitleH; { Compute the bottom coordinate of the Title rectangle }
DrawTitle(HWindow, DC, Rect);
Rect.top := Rect.bottom + WhiteH { Prepare the top coordinate of the bar rectangle }
end;
{ Draw the % bar }
Rect.bottom := Rect.top + BarH; { Compute the bottom coordinate of the bar rectangle }
DrawBar(HWindow, DC, Rect); { Draw the bar on the display }
if HasPct { Draw the percent digits if this style is on }
then
begin
Rect.top := Rect.top + { Compute the bounding rect for the percent display }
(BarH - CharH) div 2;
Rect.bottom := Rect.top + CharH;
DrawDigits(HWindow, DC, Rect);
Rect.top := Rect.top - { Restore the rectangle }
(BarH - CharH) div 2
end;
if HasTicks { Draw the axis tickmarks }
then
begin
Rect.top := Rect.top + BarH; { Compute the top coordinate of the ticks rectangle }
Rect.bottom := Rect.top + TickH; { Compute the bottom coordinate of the ticks rectangle }
DrawTicks(HWindow, DC, Rect, Style) { Draw the tick marks }
end;
if HasAxis { Draw the axis labels }
then
begin
Rect.top := Rect.bottom + { Compute the top coordinate of the ticks rectangle }
WhiteH div 2;
Rect.bottom := Rect.top + AxisH; { Compute the bottom coordinate of the ticks rectangle }
Rect.left := CRect.left;
Rect.right := CRect.right;
DrawAxis(HWindow, DC, Rect, BorderW, Style) { Draw the axis labels }
end;
EndPaint(HWindow, Paint)
end { PaintPercentCtrl };
procedure SetPercentage(HWindow: HWnd; Pct: integer);
begin { SetPercentage }
SetWindowWord (HWindow, Pct_Percentage, Pct)
end { SetPercentage };
function PercentCtrlWndFn(HWindow: HWnd;
Message,
wParam : word;
lParam : longint
): longint;
var
x : integer;
result: longint;
begin { PercentCtrlWndFn }
result := ord(TRUE);
case Message of
wm_Create :
begin
SetPercentage(HWindow, 0);
result := word(FALSE)
end;
wm_Paint : PaintPercentCtrl(HWindow);
wm_NCHitTest : result := htTransparent;
wm_EraseBkgnd : EraseBackground(HWindow, wParam);
pcm_ResetPercent:
begin
SetPercentage (HWindow, 0);
InvalidateRect(HWindow, nil, TRUE)
end;
pcm_AddPercent :
begin
x := integer(wParam);
x := x + GetPercentage(HWindow);
if x < 0
then x := 0;
if x > 100
then x := 100;
SetPercentage (HWindow, x);
InvalidateRect(HWindow, nil, TRUE)
end;
pcm_GetPercent : result := GetPercentage(HWindow);
pcm_SetPercent :
begin
x := integer(wParam);
if x < 0
then x := 0;
if x > 100
then x := 100;
SetPercentage (HWindow, x);
InvalidateRect(HWindow, nil, TRUE)
end;
else result := DefWindowProc(HWindow, Message, wParam, lParam)
end;
PercentCtrlWndFn := result
end { PercentCtrlWndFn };
end.